home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / devel / lisp / kcl_tar.z / kcl_tar / lsp / numlib.c < prev    next >
Encoding:
C/C++ Source or Header  |  1987-06-04  |  22.3 KB  |  1,143 lines
  1.  
  2. /* (C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved. */
  3. #include <cmpinclude.h>
  4. #include "numlib.h"
  5. init_numlib(start,size,data)char *start;int size;object data;
  6. {    register object *base=vs_top;register object *sup=base+VM2;vs_check;
  7.     Cstart=start;Csize=size;Cdata=data;set_VV(VV,VM1,data);
  8.     base[0]= VV[0];
  9.     (void)simple_symlispcall_no_event(VV[24],base+0,1);
  10.     base[0]= VV[1];
  11.     base[1]= VV[2];
  12.     (void)simple_symlispcall_no_event(VV[25],base+0,2);
  13.     MF(VV[26],L4,start,size,data);
  14.     MF(VV[27],L5,start,size,data);
  15.     MF(VV[28],L6,start,size,data);
  16.     MF(VV[29],L7,start,size,data);
  17.     data->v.v_self[7]=VV[7]=string_to_object(VV[7]);
  18.     vs_top=sup;
  19.     MF(VV[30],L8,start,size,data);
  20.     MF(VV[31],L9,start,size,data);
  21.     MF(VV[32],L10,start,size,data);
  22.     MF(VV[33],L11,start,size,data);
  23.     MF(VV[34],L12,start,size,data);
  24.     MF(VV[35],L13,start,size,data);
  25.     MF(VV[36],L14,start,size,data);
  26.     MF(VV[37],L15,start,size,data);
  27.     MF(VV[38],L16,start,size,data);
  28.     MF(VV[12],L17,start,size,data);
  29.     MF(VV[39],L18,start,size,data);
  30.     MF(VV[40],L19,start,size,data);
  31.     MF(VV[41],L20,start,size,data);
  32.     MF(VV[42],L21,start,size,data);
  33.     MF(VV[43],L22,start,size,data);
  34.     MF(VV[44],L23,start,size,data);
  35.     MF(VV[45],L24,start,size,data);
  36.     MF(VV[46],L25,start,size,data);
  37.     MF(VV[47],L26,start,size,data);
  38.     MF(VV[48],L27,start,size,data);
  39.     MF(VV[49],L28,start,size,data);
  40.     MF(VV[50],L29,start,size,data);
  41.     MF(VV[51],L30,start,size,data);
  42.     MF(VV[52],L31,start,size,data);
  43.     MF(VV[53],L32,start,size,data);
  44.     MF(VV[54],L33,start,size,data);
  45.     MF(VV[55],L34,start,size,data);
  46.     MF(VV[56],L35,start,size,data);
  47.     MF(VV[57],L36,start,size,data);
  48.     MF(VV[58],L37,start,size,data);
  49.     MF(VV[59],L38,start,size,data);
  50.     MF(VV[60],L39,start,size,data);
  51.     vs_top=vs_base=base;
  52. }
  53. /*    function definition for ISQRT    */
  54.  
  55. static L4()
  56. {    register object *base=vs_base;
  57.     register object *sup=base+VM3;
  58.     vs_reserve(VM3);
  59.     check_arg(1);
  60.     vs_top=sup;
  61. TTL:;
  62.     if(!(type_of(base[0])==t_fixnum||type_of(base[0])==t_bignum)){
  63.     goto T8;}
  64.     if(number_compare(base[0],VV[3])>=0){
  65.     goto T7;}
  66. T8:;
  67.     base[1]= VV[4];
  68.     base[2]= base[0];
  69.     vs_top=(vs_base=base+1)+2;
  70.     Lerror();
  71.     vs_top=sup;
  72. T7:;
  73.     if(!(number_compare(small_fixnum(0),base[0])==0)){
  74.     goto T15;}
  75.     base[1]= VV[3];
  76.     vs_top=(vs_base=base+1)+1;
  77.     return;
  78. T15:;
  79.     base[2]= base[0];
  80.     vs_top=(vs_base=base+2)+1;
  81.     Linteger_length();
  82.     vs_top=sup;
  83.     base[1]= vs_base[0];
  84.     base[4]= VV[5];
  85.     base[6]= base[1];
  86.     base[7]= VV[6];
  87.     vs_top=(vs_base=base+6)+2;
  88.     Lceiling();
  89.     vs_top=sup;
  90.     base[5]= vs_base[0];
  91.     vs_top=(vs_base=base+4)+2;
  92.     Lash();
  93.     vs_top=sup;
  94.     base[2]= vs_base[0];
  95.     base[3]= Cnil;
  96. T25:;
  97.     base[4]= base[0];
  98.     base[5]= base[2];
  99.     vs_top=(vs_base=base+4)+2;
  100.     Lfloor();
  101.     vs_top=sup;
  102.     base[3]= vs_base[0];
  103.     if(!(number_compare(base[2],base[3])<=0)){
  104.     goto T32;}
  105.     vs_top=(vs_base=base+2)+1;
  106.     return;
  107. T32:;
  108.     base[4]= number_plus(base[2],base[3]);
  109.     base[5]= VV[6];
  110.     vs_top=(vs_base=base+4)+2;
  111.     Lfloor();
  112.     vs_top=sup;
  113.     base[2]= vs_base[0];
  114.     goto T25;
  115. }
  116. /*    function definition for ABS    */
  117.  
  118. static L5()
  119. {    register object *base=vs_base;
  120.     register object *sup=base+VM4;
  121.     vs_reserve(VM4);
  122.     check_arg(1);
  123.     vs_top=sup;
  124. TTL:;
  125.     base[1]= base[0];
  126.     vs_top=(vs_base=base+1)+1;
  127.     Lcomplexp();
  128.     vs_top=sup;
  129.     if((vs_base[0])==Cnil){
  130.     goto T42;}
  131.     base[3]= base[0];
  132.     vs_top=(vs_base=base+3)+1;
  133.     Lrealpart();
  134.     vs_top=sup;
  135.     base[2]= vs_base[0];
  136.     base[4]= base[0];
  137.     vs_top=(vs_base=base+4)+1;
  138.     Lrealpart();
  139.     vs_top=sup;
  140.     base[3]= vs_base[0];
  141.     base[4]= number_times(base[2],base[3]);
  142.     base[6]= base[0];
  143.     vs_top=(vs_base=base+6)+1;
  144.     Limagpart();
  145.     vs_top=sup;
  146.     base[5]= vs_base[0];
  147.     base[7]= base[0];
  148.     vs_top=(vs_base=base+7)+1;
  149.     Limagpart();
  150.     vs_top=sup;
  151.     base[6]= vs_base[0];
  152.     base[7]= number_times(base[5],base[6]);
  153.     base[1]= number_plus(base[4],base[7]);
  154.     vs_top=(vs_base=base+1)+1;
  155.     Lsqrt();
  156.     return;
  157. T42:;
  158.     if(!(number_compare(small_fixnum(0),base[0])>0)){
  159.     goto T55;}
  160.     base[1]= number_negate(base[0]);
  161.     vs_top=(vs_base=base+1)+1;
  162.     return;
  163. T55:;
  164.     vs_top=(vs_base=base+0)+1;
  165.     return;
  166. }
  167. /*    function definition for PHASE    */
  168.  
  169. static L6()
  170. {    register object *base=vs_base;
  171.     register object *sup=base+VM5;
  172.     vs_reserve(VM5);
  173.     check_arg(1);
  174.     vs_top=sup;
  175. TTL:;
  176.     base[2]= base[0];
  177.     vs_top=(vs_base=base+2)+1;
  178.     Limagpart();
  179.     vs_top=sup;
  180.     base[1]= vs_base[0];
  181.     base[3]= base[0];
  182.     vs_top=(vs_base=base+3)+1;
  183.     Lrealpart();
  184.     vs_top=sup;
  185.     base[2]= vs_base[0];
  186.     vs_top=(vs_base=base+1)+2;
  187.     Latan();
  188.     return;
  189. }
  190. /*    function definition for SIGNUM    */
  191.  
  192. static L7()
  193. {    register object *base=vs_base;
  194.     register object *sup=base+VM6;
  195.     vs_reserve(VM6);
  196.     check_arg(1);
  197.     vs_top=sup;
  198. TTL:;
  199.     if(!(number_compare(small_fixnum(0),base[0])==0)){
  200.     goto T62;}
  201.     vs_top=(vs_base=base+0)+1;
  202.     return;
  203. T62:;
  204.     base[1]= base[0];
  205.     base[3]= base[0];
  206.     vs_top=(vs_base=base+3)+1;
  207.     L5();
  208.     vs_top=sup;
  209.     base[2]= vs_base[0];
  210.     vs_top=(vs_base=base+1)+2;
  211.     Ldivide();
  212.     return;
  213. }
  214. /*    function definition for CIS    */
  215.  
  216. static L8()
  217. {    register object *base=vs_base;
  218.     register object *sup=base+VM7;
  219.     vs_reserve(VM7);
  220.     check_arg(1);
  221.     vs_top=sup;
  222. TTL:;
  223.     base[1]= number_times(VV[7],base[0]);
  224.     vs_top=(vs_base=base+1)+1;
  225.     Lexp();
  226.     return;
  227. }
  228. /*    function definition for ASIN    */
  229.  
  230. static L9()
  231. {    register object *base=vs_base;
  232.     register object *sup=base+VM8;
  233.     vs_reserve(VM8);
  234.     check_arg(1);
  235.     vs_top=sup;
  236. TTL:;
  237.     base[4]= number_times(VV[7],base[0]);
  238.     base[7]= number_times(base[0],base[0]);
  239.     base[6]= number_minus(VV[8],base[7]);
  240.     vs_top=(vs_base=base+6)+1;
  241.     Lsqrt();
  242.     vs_top=sup;
  243.     base[5]= vs_base[0];
  244.     base[3]= number_plus(base[4],base[5]);
  245.     vs_top=(vs_base=base+3)+1;
  246.     Llog();
  247.     vs_top=sup;
  248.     base[2]= vs_base[0];
  249.     base[3]= number_times(VV[7],base[2]);
  250.     base[1]= number_negate(base[3]);
  251.     base[2]= base[0];
  252.     vs_top=(vs_base=base+2)+1;
  253.     Lcomplexp();
  254.     vs_top=sup;
  255.     if((vs_base[0])!=Cnil){
  256.     goto T74;}
  257.     base[3]= base[1];
  258.     vs_top=(vs_base=base+3)+1;
  259.     Limagpart();
  260.     vs_top=sup;
  261.     base[2]= vs_base[0];
  262.     if(!(number_compare(small_fixnum(0),base[2])==0)){
  263.     goto T74;}
  264.     base[2]= base[1];
  265.     vs_top=(vs_base=base+2)+1;
  266.     Lrealpart();
  267.     return;
  268. T74:;
  269.     vs_top=(vs_base=base+1)+1;
  270.     return;
  271. }
  272. /*    function definition for ACOS    */
  273.  
  274. static L10()
  275. {    register object *base=vs_base;
  276.     register object *sup=base+VM9;
  277.     vs_reserve(VM9);
  278.     check_arg(1);
  279.     vs_top=sup;
  280. TTL:;
  281.     base[6]= number_times(base[0],base[0]);
  282.     base[5]= number_minus(VV[8],base[6]);
  283.     vs_top=(vs_base=base+5)+1;
  284.     Lsqrt();
  285.     vs_top=sup;
  286.     base[4]= vs_base[0];
  287.     base[5]= number_times(VV[7],base[4]);
  288.     base[3]= number_plus(base[0],base[5]);
  289.     vs_top=(vs_base=base+3)+1;
  290.     Llog();
  291.     vs_top=sup;
  292.     base[2]= vs_base[0];
  293.     base[3]= number_times(VV[7],base[2]);
  294.     base[1]= number_negate(base[3]);
  295.     base[2]= base[0];
  296.     vs_top=(vs_base=base+2)+1;
  297.     Lcomplexp();
  298.     vs_top=sup;
  299.     if((vs_base[0])!=Cnil){
  300.     goto T88;}
  301.     base[3]= base[1];
  302.     vs_top=(vs_base=base+3)+1;
  303.     Limagpart();
  304.     vs_top=sup;
  305.     base[2]= vs_base[0];
  306.     if(!(number_compare(small_fixnum(0),base[2])==0)){
  307.     goto T88;}
  308.     base[2]= base[1];
  309.     vs_top=(vs_base=base+2)+1;
  310.     Lrealpart();
  311.     return;
  312. T88:;
  313.     vs_top=(vs_base=base+1)+1;
  314.     return;
  315. }
  316. /*    function definition for SINH    */
  317.  
  318. static L11()
  319. {    register object *base=vs_base;
  320.     register object *sup=base+VM10;
  321.     vs_reserve(VM10);
  322.     check_arg(1);
  323.     vs_top=sup;
  324. TTL:;
  325.     base[3]= base[0];
  326.     vs_top=(vs_base=base+3)+1;
  327.     Lexp();
  328.     vs_top=sup;
  329.     base[2]= vs_base[0];
  330.     base[4]= number_negate(base[0]);
  331.     vs_top=(vs_base=base+4)+1;
  332.     Lexp();
  333.     vs_top=sup;
  334.     base[3]= vs_base[0];
  335.     base[1]= number_minus(base[2],base[3]);
  336.     base[2]= VV[9];
  337.     vs_top=(vs_base=base+1)+2;
  338.     Ldivide();
  339.     return;
  340. }
  341. /*    function definition for COSH    */
  342.  
  343. static L12()
  344. {    register object *base=vs_base;
  345.     register object *sup=base+VM11;
  346.     vs_reserve(VM11);
  347.     check_arg(1);
  348.     vs_top=sup;
  349. TTL:;
  350.     base[3]= base[0];
  351.     vs_top=(vs_base=base+3)+1;
  352.     Lexp();
  353.     vs_top=sup;
  354.     base[2]= vs_base[0];
  355.     base[4]= number_negate(base[0]);
  356.     vs_top=(vs_base=base+4)+1;
  357.     Lexp();
  358.     vs_top=sup;
  359.     base[3]= vs_base[0];
  360.     base[1]= number_plus(base[2],base[3]);
  361.     base[2]= VV[9];
  362.     vs_top=(vs_base=base+1)+2;
  363.     Ldivide();
  364.     return;
  365. }
  366. /*    function definition for TANH    */
  367.  
  368. static L13()
  369. {    register object *base=vs_base;
  370.     register object *sup=base+VM12;
  371.     vs_reserve(VM12);
  372.     check_arg(1);
  373.     vs_top=sup;
  374. TTL:;
  375.     base[2]= base[0];
  376.     vs_top=(vs_base=base+2)+1;
  377.     L11();
  378.     vs_top=sup;
  379.     base[1]= vs_base[0];
  380.     base[3]= base[0];
  381.     vs_top=(vs_base=base+3)+1;
  382.     L12();
  383.     vs_top=sup;
  384.     base[2]= vs_base[0];
  385.     vs_top=(vs_base=base+1)+2;
  386.     Ldivide();
  387.     return;
  388. }
  389. /*    function definition for ASINH    */
  390.  
  391. static L14()
  392. {    register object *base=vs_base;
  393.     register object *sup=base+VM13;
  394.     vs_reserve(VM13);
  395.     check_arg(1);
  396.     vs_top=sup;
  397. TTL:;
  398.     base[4]= number_times(base[0],base[0]);
  399.     base[3]= number_plus(VV[8],base[4]);
  400.     vs_top=(vs_base=base+3)+1;
  401.     Lsqrt();
  402.     vs_top=sup;
  403.     base[2]= vs_base[0];
  404.     base[1]= number_plus(base[0],base[2]);
  405.     vs_top=(vs_base=base+1)+1;
  406.     Llog();
  407.     return;
  408. }
  409. /*    function definition for ACOSH    */
  410.  
  411. static L15()
  412. {    register object *base=vs_base;
  413.     register object *sup=base+VM14;
  414.     vs_reserve(VM14);
  415.     check_arg(1);
  416.     vs_top=sup;
  417. TTL:;
  418.     base[2]= one_plus(base[0]);
  419.     base[5]= one_minus(base[0]);
  420.     base[6]= one_plus(base[0]);
  421.     vs_top=(vs_base=base+5)+2;
  422.     Ldivide();
  423.     vs_top=sup;
  424.     base[4]= vs_base[0];
  425.     vs_top=(vs_base=base+4)+1;
  426.     Lsqrt();
  427.     vs_top=sup;
  428.     base[3]= vs_base[0];
  429.     base[4]= number_times(base[2],base[3]);
  430.     base[1]= number_plus(base[0],base[4]);
  431.     vs_top=(vs_base=base+1)+1;
  432.     Llog();
  433.     return;
  434. }
  435. /*    function definition for ATANH    */
  436.  
  437. static L16()
  438. {    register object *base=vs_base;
  439.     register object *sup=base+VM15;
  440.     vs_reserve(VM15);
  441.     check_arg(1);
  442.     vs_top=sup;
  443. TTL:;
  444.     if(number_compare(base[0],VV[8])==0){
  445.     goto T121;}
  446.     if(!(number_compare(base[0],VV[10])==0)){
  447.     goto T120;}
  448. T121:;
  449.     base[1]= VV[11];
  450.     base[2]= base[0];
  451.     vs_top=(vs_base=base+1)+2;
  452.     Lerror();
  453.     vs_top=sup;
  454. T120:;
  455.     base[2]= one_plus(base[0]);
  456.     base[5]= number_times(base[0],base[0]);
  457.     base[4]= number_minus(VV[8],base[5]);
  458.     vs_top=(vs_base=base+4)+1;
  459.     Lsqrt();
  460.     vs_top=sup;
  461.     base[3]= vs_base[0];
  462.     vs_top=(vs_base=base+2)+2;
  463.     Ldivide();
  464.     vs_top=sup;
  465.     base[1]= vs_base[0];
  466.     vs_top=(vs_base=base+1)+1;
  467.     Llog();
  468.     return;
  469. }
  470. /*    function definition for RATIONAL    */
  471.  
  472. static L17()
  473. {    register object *base=vs_base;
  474.     register object *sup=base+VM16;
  475.     vs_reserve(VM16);
  476.     check_arg(1);
  477.     vs_top=sup;
  478. TTL:;
  479.     base[2]= base[0];
  480.     vs_top=(vs_base=base+2)+1;
  481.     Linteger_decode_float();
  482.     Llist();
  483.     vs_top=sup;
  484.     base[1]= vs_base[0];
  485.     base[2]= car(base[1]);
  486.     base[3]= cadr(base[1]);
  487.     base[4]= caddr(base[1]);
  488.     if(!(number_compare(base[4],VV[3])>=0)){
  489.     goto T138;}
  490.     base[6]= base[0];
  491.     vs_top=(vs_base=base+6)+1;
  492.     Lfloat_radix();
  493.     vs_top=sup;
  494.     base[5]= vs_base[0];
  495.     base[6]= number_expt(base[5],base[3]);
  496.     base[7]= number_times(base[2],base[6]);
  497.     vs_top=(vs_base=base+7)+1;
  498.     return;
  499. T138:;
  500.     base[6]= base[0];
  501.     vs_top=(vs_base=base+6)+1;
  502.     Lfloat_radix();
  503.     vs_top=sup;
  504.     base[5]= vs_base[0];
  505.     base[6]= number_expt(base[5],base[3]);
  506.     base[7]= number_times(base[2],base[6]);
  507.     base[8]= number_negate(base[7]);
  508.     vs_top=(vs_base=base+8)+1;
  509.     return;
  510. }
  511. /*    function definition for RATIONALIZE    */
  512.  
  513. static L18()
  514. {    register object *base=vs_base;
  515.     register object *sup=base+VM17;
  516.     vs_reserve(VM17);
  517.     check_arg(1);
  518.     vs_top=sup;
  519. TTL:;
  520.     base[2]= base[0];
  521.     base[3]= VV[12];
  522.     if((simple_symlispcall_no_event(VV[61],base+2,2))==Cnil){
  523.     goto T145;}
  524.     vs_top=(vs_base=base+0)+1;
  525.     return;
  526. T145:;
  527.     base[2]= base[0];
  528.     base[3]= VV[13];
  529.     if((simple_symlispcall_no_event(VV[61],base+2,2))==Cnil){
  530.     goto T150;}
  531.     base[2]= base[0];
  532.     base[3]= VV[14];
  533.     vs_top=(vs_base=base+2)+2;
  534.     L19();
  535.     return;
  536. T150:;
  537.     base[2]= base[0];
  538.     base[3]= VV[15];
  539.     if((simple_symlispcall_no_event(VV[61],base+2,2))==Cnil){
  540.     goto T157;}
  541.     base[2]= base[0];
  542.     base[3]= VV[16];
  543.     vs_top=(vs_base=base+2)+2;
  544.     L19();
  545.     return;
  546. T157:;
  547.     base[2]= VV[17];
  548.     base[3]= base[0];
  549.     vs_top=(vs_base=base+2)+2;
  550.     Lerror();
  551.     return;
  552. }
  553. /*    function definition for RATIONALIZE-FLOAT    */
  554.  
  555. static L19()
  556. {    register object *base=vs_base;
  557.     register object *sup=base+VM18;
  558.     vs_reserve(VM18);
  559.     check_arg(2);
  560.     vs_top=sup;
  561. TTL:;
  562.     if(!(number_compare(small_fixnum(0),base[0])>0)){
  563.     goto T166;}
  564.     base[3]= number_negate(base[0]);
  565.     vs_top=(vs_base=base+3)+1;
  566.     L18();
  567.     vs_top=sup;
  568.     base[2]= vs_base[0];
  569.     base[3]= number_negate(base[2]);
  570.     vs_top=(vs_base=base+3)+1;
  571.     return;
  572. T166:;
  573.     if(!(number_compare(small_fixnum(0),base[0])==0)){
  574.     goto T171;}
  575.     base[2]= VV[3];
  576.     vs_top=(vs_base=base+2)+1;
  577.     return;
  578. T171:;
  579.     base[2]= Cnil;
  580.     base[3]= Cnil;
  581.     base[9]= base[0];
  582.     vs_top=(vs_base=base+9)+1;
  583.     Ltruncate();
  584.     vs_top=sup;
  585.     base[3]= vs_base[0];
  586.     base[5]= base[3];
  587.     base[4]= base[0];
  588.     base[6]= VV[5];
  589.     base[7]= VV[5];
  590.     base[8]= VV[3];
  591. T177:;
  592.     if(number_compare(small_fixnum(0),base[6])==0){
  593.     goto T178;}
  594.     base[14]= base[5];
  595.     base[15]= base[0];
  596.     vs_top=(vs_base=base+14)+2;
  597.     Lfloat();
  598.     vs_top=sup;
  599.     base[13]= vs_base[0];
  600.     base[15]= base[6];
  601.     base[16]= base[0];
  602.     vs_top=(vs_base=base+15)+2;
  603.     Lfloat();
  604.     vs_top=sup;
  605.     base[14]= vs_base[0];
  606.     vs_top=(vs_base=base+13)+2;
  607.     Ldivide();
  608.     vs_top=sup;
  609.     base[12]= vs_base[0];
  610.     base[11]= number_minus(base[0],base[12]);
  611.     base[12]= base[0];
  612.     vs_top=(vs_base=base+11)+2;
  613.     Ldivide();
  614.     vs_top=sup;
  615.     base[10]= vs_base[0];
  616.     vs_top=(vs_base=base+10)+1;
  617.     L5();
  618.     vs_top=sup;
  619.     base[9]= vs_base[0];
  620.     if(number_compare(base[9],base[1])>0){
  621.     goto T178;}
  622.     base[9]= base[5];
  623.     base[10]= base[6];
  624.     vs_top=(vs_base=base+9)+2;
  625.     Ldivide();
  626.     return;
  627. T178:;
  628.     base[9]= VV[8];
  629.     base[12]= base[3];
  630.     base[13]= base[0];
  631.     vs_top=(vs_base=base+12)+2;
  632.     Lfloat();
  633.     vs_top=sup;
  634.     base[11]= vs_base[0];
  635.     base[10]= number_minus(base[4],base[11]);
  636.     vs_top=(vs_base=base+9)+2;
  637.     Ldivide();
  638.     vs_top=sup;
  639.     base[2]= vs_base[0];
  640.     base[4]= base[2];
  641.     base[11]= base[2];
  642.     vs_top=(vs_base=base+11)+1;
  643.     Ltruncate();
  644.     vs_top=sup;
  645.     base[3]= vs_base[0];
  646.     base[10]= base[3];
  647.     base[11]= number_times(base[10],base[5]);
  648.     base[9]= number_plus(base[11],base[7]);
  649.     base[11]= number_times(base[3],base[6]);
  650.     base[10]= number_plus(base[11],base[8]);
  651.     base[7]= base[5];
  652.     base[8]= base[6];
  653.     base[6]= base[10];
  654.     base[5]= base[9];
  655.     goto T177;
  656. }
  657. /*    function definition for FFLOOR    */
  658.  
  659. static L20()
  660. {    register object *base=vs_base;
  661.     register object *sup=base+VM19;
  662.     vs_reserve(VM19);
  663.     if(vs_top-vs_base<1) too_few_arguments();
  664.     if(vs_top-vs_base>2) too_many_arguments();
  665.     vs_base=vs_base+1;
  666.     if(vs_base>=vs_top){vs_top=sup;goto T213;}
  667.     vs_top=sup;
  668.     goto T214;
  669. T213:;
  670.     base[1]= VV[8];
  671. T214:;
  672.     base[4]= base[0];
  673.     vs_top=(vs_base=base+4)+1;
  674.     Lfloat();
  675.     vs_top=sup;
  676.     base[3]= vs_base[0];
  677.     base[5]= base[1];
  678.     vs_top=(vs_base=base+5)+1;
  679.     Lfloat();
  680.     vs_top=sup;
  681.     base[4]= vs_base[0];
  682.     vs_top=(vs_base=base+3)+2;
  683.     Lfloor();
  684.     Llist();
  685.     vs_top=sup;
  686.     base[2]= vs_base[0];
  687.     base[3]= car(base[2]);
  688.     base[4]= cadr(base[2]);
  689.     base[6]= base[3];
  690.     base[7]= base[4];
  691.     vs_top=(vs_base=base+6)+2;
  692.     Lfloat();
  693.     vs_top=sup;
  694.     base[5]= vs_base[0];
  695.     base[6]= base[4];
  696.     vs_base=base+5;vs_top=base+7;
  697.     return;
  698. }
  699. /*    function definition for FCEILING    */
  700.  
  701. static L21()
  702. {    register object *base=vs_base;
  703.     register object *sup=base+VM20;
  704.     vs_reserve(VM20);
  705.     if(vs_top-vs_base<1) too_few_arguments();
  706.     if(vs_top-vs_base>2) too_many_arguments();
  707.     vs_base=vs_base+1;
  708.     if(vs_base>=vs_top){vs_top=sup;goto T228;}
  709.     vs_top=sup;
  710.     goto T229;
  711. T228:;
  712.     base[1]= VV[8];
  713. T229:;
  714.     base[4]= base[0];
  715.     vs_top=(vs_base=base+4)+1;
  716.     Lfloat();
  717.     vs_top=sup;
  718.     base[3]= vs_base[0];
  719.     base[5]= base[1];
  720.     vs_top=(vs_base=base+5)+1;
  721.     Lfloat();
  722.     vs_top=sup;
  723.     base[4]= vs_base[0];
  724.     vs_top=(vs_base=base+3)+2;
  725.     Lceiling();
  726.     Llist();
  727.     vs_top=sup;
  728.     base[2]= vs_base[0];
  729.     base[3]= car(base[2]);
  730.     base[4]= cadr(base[2]);
  731.     base[6]= base[3];
  732.     base[7]= base[4];
  733.     vs_top=(vs_base=base+6)+2;
  734.     Lfloat();
  735.     vs_top=sup;
  736.     base[5]= vs_base[0];
  737.     base[6]= base[4];
  738.     vs_base=base+5;vs_top=base+7;
  739.     return;
  740. }
  741. /*    function definition for FTRUNCATE    */
  742.  
  743. static L22()
  744. {    register object *base=vs_base;
  745.     register object *sup=base+VM21;
  746.     vs_reserve(VM21);
  747.     if(vs_top-vs_base<1) too_few_arguments();
  748.     if(vs_top-vs_base>2) too_many_arguments();
  749.     vs_base=vs_base+1;
  750.     if(vs_base>=vs_top){vs_top=sup;goto T243;}
  751.     vs_top=sup;
  752.     goto T244;
  753. T243:;
  754.     base[1]= VV[8];
  755. T244:;
  756.     base[4]= base[0];
  757.     vs_top=(vs_base=base+4)+1;
  758.     Lfloat();
  759.     vs_top=sup;
  760.     base[3]= vs_base[0];
  761.     base[5]= base[1];
  762.     vs_top=(vs_base=base+5)+1;
  763.     Lfloat();
  764.     vs_top=sup;
  765.     base[4]= vs_base[0];
  766.     vs_top=(vs_base=base+3)+2;
  767.     Ltruncate();
  768.     Llist();
  769.     vs_top=sup;
  770.     base[2]= vs_base[0];
  771.     base[3]= car(base[2]);
  772.     base[4]= cadr(base[2]);
  773.     base[6]= base[3];
  774.     base[7]= base[4];
  775.     vs_top=(vs_base=base+6)+2;
  776.     Lfloat();
  777.     vs_top=sup;
  778.     base[5]= vs_base[0];
  779.     base[6]= base[4];
  780.     vs_base=base+5;vs_top=base+7;
  781.     return;
  782. }
  783. /*    function definition for FROUND    */
  784.  
  785. static L23()
  786. {    register object *base=vs_base;
  787.     register object *sup=base+VM22;
  788.     vs_reserve(VM22);
  789.     if(vs_top-vs_base<1) too_few_arguments();
  790.     if(vs_top-vs_base>2) too_many_arguments();
  791.     vs_base=vs_base+1;
  792.     if(vs_base>=vs_top){vs_top=sup;goto T258;}
  793.     vs_top=sup;
  794.     goto T259;
  795. T258:;
  796.     base[1]= VV[8];
  797. T259:;
  798.     base[4]= base[0];
  799.     vs_top=(vs_base=base+4)+1;
  800.     Lfloat();
  801.     vs_top=sup;
  802.     base[3]= vs_base[0];
  803.     base[5]= base[1];
  804.     vs_top=(vs_base=base+5)+1;
  805.     Lfloat();
  806.     vs_top=sup;
  807.     base[4]= vs_base[0];
  808.     vs_top=(vs_base=base+3)+2;
  809.     Lround();
  810.     Llist();
  811.     vs_top=sup;
  812.     base[2]= vs_base[0];
  813.     base[3]= car(base[2]);
  814.     base[4]= cadr(base[2]);
  815.     base[6]= base[3];
  816.     base[7]= base[4];
  817.     vs_top=(vs_base=base+6)+2;
  818.     Lfloat();
  819.     vs_top=sup;
  820.     base[5]= vs_base[0];
  821.     base[6]= base[4];
  822.     vs_base=base+5;vs_top=base+7;
  823.     return;
  824. }
  825. /*    function definition for LOGNAND    */
  826.  
  827. static L24()
  828. {    register object *base=vs_base;
  829.     register object *sup=base+VM23;
  830.     vs_reserve(VM23);
  831.     check_arg(2);
  832.     vs_top=sup;
  833. TTL:;
  834.     base[2]= VV[18];
  835.     base[3]= base[0];
  836.     base[4]= base[1];
  837.     vs_top=(vs_base=base+2)+3;
  838.     Lboole();
  839.     return;
  840. }
  841. /*    function definition for LOGNOR    */
  842.  
  843. static L25()
  844. {    register object *base=vs_base;
  845.     register object *sup=base+VM24;
  846.     vs_reserve(VM24);
  847.     check_arg(2);
  848.     vs_top=sup;
  849. TTL:;
  850.     base[2]= VV[19];
  851.     base[3]= base[0];
  852.     base[4]= base[1];
  853.     vs_top=(vs_base=base+2)+3;
  854.     Lboole();
  855.     return;
  856. }
  857. /*    function definition for LOGANDC1    */
  858.  
  859. static L26()
  860. {    register object *base=vs_base;
  861.     register object *sup=base+VM25;
  862.     vs_reserve(VM25);
  863.     check_arg(2);
  864.     vs_top=sup;
  865. TTL:;
  866.     base[2]= VV[20];
  867.     base[3]= base[0];
  868.     base[4]= base[1];
  869.     vs_top=(vs_base=base+2)+3;
  870.     Lboole();
  871.     return;
  872. }
  873. /*    function definition for LOGANDC2    */
  874.  
  875. static L27()
  876. {    register object *base=vs_base;
  877.     register object *sup=base+VM26;
  878.     vs_reserve(VM26);
  879.     check_arg(2);
  880.     vs_top=sup;
  881. TTL:;
  882.     base[2]= VV[6];
  883.     base[3]= base[0];
  884.     base[4]= base[1];
  885.     vs_top=(vs_base=base+2)+3;
  886.     Lboole();
  887.     return;
  888. }
  889. /*    function definition for LOGORC1    */
  890.  
  891. static L28()
  892. {    register object *base=vs_base;
  893.     register object *sup=base+VM27;
  894.     vs_reserve(VM27);
  895.     check_arg(2);
  896.     vs_top=sup;
  897. TTL:;
  898.     base[2]= VV[21];
  899.     base[3]= base[0];
  900.     base[4]= base[1];
  901.     vs_top=(vs_base=base+2)+3;
  902.     Lboole();
  903.     return;
  904. }
  905. /*    function definition for LOGORC2    */
  906.  
  907. static L29()
  908. {    register object *base=vs_base;
  909.     register object *sup=base+VM28;
  910.     vs_reserve(VM28);
  911.     check_arg(2);
  912.     vs_top=sup;
  913. TTL:;
  914.     base[2]= VV[22];
  915.     base[3]= base[0];
  916.     base[4]= base[1];
  917.     vs_top=(vs_base=base+2)+3;
  918.     Lboole();
  919.     return;
  920. }
  921. /*    function definition for LOGNOT    */
  922.  
  923. static L30()
  924. {    register object *base=vs_base;
  925.     register object *sup=base+VM29;
  926.     vs_reserve(VM29);
  927.     check_arg(1);
  928.     vs_top=sup;
  929. TTL:;
  930.     base[1]= VV[23];
  931.     base[2]= base[0];
  932.     vs_top=(vs_base=base+1)+2;
  933.     Llogxor();
  934.     return;
  935. }
  936. /*    function definition for LOGTEST    */
  937.  
  938. static L31()
  939. {    register object *base=vs_base;
  940.     register object *sup=base+VM30;
  941.     vs_reserve(VM30);
  942.     check_arg(2);
  943.     vs_top=sup;
  944. TTL:;
  945.     base[3]= base[0];
  946.     base[4]= base[1];
  947.     vs_top=(vs_base=base+3)+2;
  948.     Llogand();
  949.     vs_top=sup;
  950.     base[2]= vs_base[0];
  951.     base[3]= (((number_compare(small_fixnum(0),base[2])==0?Ct:Cnil))==Cnil?Ct:Cnil);
  952.     vs_top=(vs_base=base+3)+1;
  953.     return;
  954. }
  955. /*    function definition for BYTE    */
  956.  
  957. static L32()
  958. {    register object *base=vs_base;
  959.     register object *sup=base+VM31;
  960.     vs_reserve(VM31);
  961.     check_arg(2);
  962.     vs_top=sup;
  963. TTL:;
  964.     base[2]= make_cons(base[0],base[1]);
  965.     vs_top=(vs_base=base+2)+1;
  966.     return;
  967. }
  968. /*    function definition for BYTE-SIZE    */
  969.  
  970. static L33()
  971. {    register object *base=vs_base;
  972.     register object *sup=base+VM32;
  973.     vs_reserve(VM32);
  974.     check_arg(1);
  975.     vs_top=sup;
  976. TTL:;
  977.     base[1]= car(base[0]);
  978.     vs_top=(vs_base=base+1)+1;
  979.     return;
  980. }
  981. /*    function definition for BYTE-POSITION    */
  982.  
  983. static L34()
  984. {    register object *base=vs_base;
  985.     register object *sup=base+VM33;
  986.     vs_reserve(VM33);
  987.     check_arg(1);
  988.     vs_top=sup;
  989. TTL:;
  990.     base[1]= cdr(base[0]);
  991.     vs_top=(vs_base=base+1)+1;
  992.     return;
  993. }
  994. /*    function definition for LDB    */
  995.  
  996. static L35()
  997. {    register object *base=vs_base;
  998.     register object *sup=base+VM34;
  999.     vs_reserve(VM34);
  1000.     check_arg(2);
  1001.     vs_top=sup;
  1002. TTL:;
  1003.     base[3]= base[1];
  1004.     base[6]= base[0];
  1005.     vs_top=(vs_base=base+6)+1;
  1006.     L34();
  1007.     vs_top=sup;
  1008.     base[5]= vs_base[0];
  1009.     base[4]= number_negate(base[5]);
  1010.     vs_top=(vs_base=base+3)+2;
  1011.     Lash();
  1012.     vs_top=sup;
  1013.     base[2]= vs_base[0];
  1014.     base[5]= VV[5];
  1015.     base[7]= base[0];
  1016.     vs_top=(vs_base=base+7)+1;
  1017.     L33();
  1018.     vs_top=sup;
  1019.     base[6]= vs_base[0];
  1020.     vs_top=(vs_base=base+5)+2;
  1021.     Lash();
  1022.     vs_top=sup;
  1023.     base[4]= vs_base[0];
  1024.     base[3]= number_negate(base[4]);
  1025.     vs_top=(vs_base=base+2)+2;
  1026.     L27();
  1027.     return;
  1028. }
  1029. /*    function definition for LDB-TEST    */
  1030.  
  1031. static L36()
  1032. {    register object *base=vs_base;
  1033.     register object *sup=base+VM35;
  1034.     vs_reserve(VM35);
  1035.     check_arg(2);
  1036.     vs_top=sup;
  1037. TTL:;
  1038.     base[3]= base[0];
  1039.     base[4]= base[1];
  1040.     vs_top=(vs_base=base+3)+2;
  1041.     L35();
  1042.     vs_top=sup;
  1043.     base[2]= vs_base[0];
  1044.     base[3]= (((number_compare(small_fixnum(0),base[2])==0?Ct:Cnil))==Cnil?Ct:Cnil);
  1045.     vs_top=(vs_base=base+3)+1;
  1046.     return;
  1047. }
  1048. /*    function definition for MASK-FIELD    */
  1049.  
  1050. static L37()
  1051. {    register object *base=vs_base;
  1052.     register object *sup=base+VM36;
  1053.     vs_reserve(VM36);
  1054.     check_arg(2);
  1055.     vs_top=sup;
  1056. TTL:;
  1057.     base[3]= base[0];
  1058.     base[4]= base[1];
  1059.     vs_top=(vs_base=base+3)+2;
  1060.     L35();
  1061.     vs_top=sup;
  1062.     base[2]= vs_base[0];
  1063.     base[4]= base[0];
  1064.     vs_top=(vs_base=base+4)+1;
  1065.     L34();
  1066.     vs_top=sup;
  1067.     base[3]= vs_base[0];
  1068.     vs_top=(vs_base=base+2)+2;
  1069.     Lash();
  1070.     return;
  1071. }
  1072. /*    function definition for DPB    */
  1073.  
  1074. static L38()
  1075. {    register object *base=vs_base;
  1076.     register object *sup=base+VM37;
  1077.     vs_reserve(VM37);
  1078.     check_arg(3);
  1079.     vs_top=sup;
  1080. TTL:;
  1081.     base[3]= base[2];
  1082.     base[5]= base[1];
  1083.     base[6]= base[2];
  1084.     vs_top=(vs_base=base+5)+2;
  1085.     L37();
  1086.     vs_top=sup;
  1087.     base[4]= vs_base[0];
  1088.     base[7]= base[0];
  1089.     base[10]= VV[5];
  1090.     base[12]= base[1];
  1091.     vs_top=(vs_base=base+12)+1;
  1092.     L33();
  1093.     vs_top=sup;
  1094.     base[11]= vs_base[0];
  1095.     vs_top=(vs_base=base+10)+2;
  1096.     Lash();
  1097.     vs_top=sup;
  1098.     base[9]= vs_base[0];
  1099.     base[8]= number_negate(base[9]);
  1100.     vs_top=(vs_base=base+7)+2;
  1101.     L27();
  1102.     vs_top=sup;
  1103.     base[6]= vs_base[0];
  1104.     base[8]= base[1];
  1105.     vs_top=(vs_base=base+8)+1;
  1106.     L34();
  1107.     vs_top=sup;
  1108.     base[7]= vs_base[0];
  1109.     vs_top=(vs_base=base+6)+2;
  1110.     Lash();
  1111.     vs_top=sup;
  1112.     base[5]= vs_base[0];
  1113.     vs_top=(vs_base=base+3)+3;
  1114.     Llogxor();
  1115.     return;
  1116. }
  1117. /*    function definition for DEPOSIT-FIELD    */
  1118.  
  1119. static L39()
  1120. {    register object *base=vs_base;
  1121.     register object *sup=base+VM38;
  1122.     vs_reserve(VM38);
  1123.     check_arg(3);
  1124.     vs_top=sup;
  1125. TTL:;
  1126.     base[4]= base[0];
  1127.     base[7]= base[1];
  1128.     vs_top=(vs_base=base+7)+1;
  1129.     L34();
  1130.     vs_top=sup;
  1131.     base[6]= vs_base[0];
  1132.     base[5]= number_negate(base[6]);
  1133.     vs_top=(vs_base=base+4)+2;
  1134.     Lash();
  1135.     vs_top=sup;
  1136.     base[3]= vs_base[0];
  1137.     base[4]= base[1];
  1138.     base[5]= base[2];
  1139.     vs_top=(vs_base=base+3)+3;
  1140.     L38();
  1141.     return;
  1142. }
  1143.